;; -*- Mode: Lisp; -*-

;;;; Simple shakedown procedure for JTRE
;;;; Last edited 1/29/93, by KDF

;;; Copyright (c) 1988-1992, Kenneth D. Forbus, Northwestern University,
;;; and Johan de Kleer, the Xerox Corporation.
;;; All rights reserved.

;;; See the file legal.txt for a paragraph stating scope of permission
;;; and disclaimer of warranty.  The above copyright notice and that
;;; paragraph must be included in any separate copy of this file.

(defpackage #:bps/jtms/jtest
  (:use #:cl #:bps/jtms)
  (:export
   #:shakedown-jtre))

(in-package #:bps/jtms/jtest)

(defun shakedown-jtre ()
  (in-jtre (create-jtre "Test One"))
  (dolist (form '((rule ((:INTERN (foo ?x) :VAR ?f :TEST (numberp ?x))
                         (:INTERN (bar ?y) :VAR ?g :TEST (numberp ?y)))
                        (rassert! (mumble ?x ?y) (Test-intern ?f ?g)))
                  (format t "~% :INTERN rule defined okay.")
                  (rule ((:IN (foo ?x) :VAR ?f
                              :TEST (not (numberp ?x)))
                         (:IN (bar ?y) :VAR ?g
                              :TEST (not (numberp ?y))))
                        (rassert! (grumble ?x ?y)
                         (:TEST-in ?f ?g)))
                  (format t "~% :IN rule defined okay.")
                  (referent '(foo 1) t)
                  (cond ((fetch '(foo 1))
                         (format t "~% Referent worked okay."))
                        (t (error "Referent failed.")))
                  (referent '(bar 1) t)
                  (run-rules)
                  (format t "~% No errors during attempted rule execution.")
                  (cond ((fetch '(mumble 1 1))
                         (format t "~%:INTERN rule fired okay."))
                        (t (error "~% :INTERN rule failed to fire.")))
                  (referent '(foo a) t)
                  (referent '(bar a) t)
                  (run-rules)
                  (when (some #'(lambda (fact) (in? fact))
                              (fetch '(grumble ?p ?q)))
                        (format t "~%Premature triggering of :IN rule."))
                  (uassume! '(foo a) :USER)
                  (uassume! '(bar a) :USER)
                  (cond ((in? '(grumble a a))
                         (format t "~% :IN rule worked okay."))
                        (t (format t "~%:IN rule failed to fire.")))
                  (uassume! '(foo 1) :USER)
                  (uassume! '(bar 1) :USER)
                  (unless (in? '(mumble 1 1))
                          (format t "~% Reference or JTMS failure.")))
                :OKAY)
          (print (eval form))))
